home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / gsdb21.arc / GS_STRNG.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-04  |  11KB  |  290 lines
  1. unit GS_Strng;
  2. interface
  3. uses
  4.    Crt, Dos;
  5.  
  6. function AllCaps(var t : string) : string;
  7. procedure CnvAscToStr(var asc, st; lth : integer);
  8. procedure CnvStrToAsc(var st, asc; lth : integer);
  9. function StrDate(data : string) : string;
  10. function StrNumber(num : real; lth,dec : integer) : string;
  11. function StrLogic(tf : boolean) : string;
  12. function SubStr(s : string; b,l : integer) : string;
  13. function TrimL(strn : string):string; {Deletes leading spaces}
  14. function TrimR(strn : string):string; {Deletes trailing spaces}
  15. function Unique_Field : string;       {Used to create a unique 8-byte string}
  16. function ValNumber(strn : string) : real;
  17. function ValLogic(strn : string) : boolean;
  18.  
  19.  
  20. implementation
  21.  
  22. function AllCaps(var t : string) : string;
  23. var
  24.    i : integer;
  25.    s : string;
  26. begin
  27.    s := t;
  28.    for i := 1 to length(s) do s[i] := upcase(s[i]);
  29.    AllCaps := s;
  30. end;
  31.  
  32. procedure CnvAscToStr(var asc, st; lth : integer);
  33. var
  34.    a : array[0..255] of byte absolute asc;
  35.    s : string[255] absolute st;
  36.    i : integer;
  37. begin
  38.    move(a,s[1],lth);
  39.    s[0] := chr(lth);
  40.    i := pos(#0,s);
  41.    if i > 0 then dec(i);
  42.    s[0] := chr(i);
  43. end;
  44.  
  45. procedure CnvStrToAsc(var st, asc; lth : integer);
  46. var
  47.    a : array[0..255] of byte absolute asc;
  48.    s : string[255] absolute st;
  49.    t : string;
  50.    i : integer;
  51. begin
  52.    t := s;
  53.    FillChar(a,lth,#0);
  54.    i := length(t);
  55.    if i >= lth then i := lth;
  56.    move(t[1],a,i);
  57. end;
  58.  
  59. function StrDate(data : string) : string;
  60. var
  61.    t : string[10];
  62. begin
  63.    t := '        ';
  64.    if length(data) = 8 then
  65.    begin
  66.       move(data[5], t[1], 2);   {Move month to first two positions}
  67.       move(data[7], t[4], 2);   {Move day to positions 4-5}
  68.       move(data[3], t[7], 2);   {Move year to positions 7-8}
  69.    end;
  70.    t[3] := '/';
  71.    t[6] := '/';          {Insert delimiters}
  72.    t[0] := #8;           {Set length to 8}
  73.    StrDate := t;
  74. end;
  75.  
  76. function StrNumber(num : real; lth,dec : integer) : string;
  77. var
  78.    s : string;
  79. begin
  80.    Str(num:lth:dec,s);
  81.    StrNumber := s;
  82. end;
  83.  
  84. function StrLogic(tf : boolean) : string;
  85. begin
  86.    if tf then StrLogic := 'T' else StrLogic := 'F';
  87. end;
  88.  
  89. {.pa}
  90. {
  91.  
  92.                                    SUBSTR
  93.  
  94.      ╔══════════════════════════════════════════════════════════════════╗
  95.      ║                                                                  ║
  96.      ║   The SUBSTR function extracts a substring from a string.        ║
  97.      ║                                                                  ║
  98.      ║       Calling the Method:                                        ║
  99.      ║                                                                  ║
  100.      ║               x := SubStr(s,b,l)                                 ║
  101.      ║                                                                  ║
  102.      ║               ( where x is the string to be trimmed.             ║
  103.      ║                       s is of type string.                       ║
  104.      ║                       b is the integer start of substring.       ║
  105.      ║                       l is the integer length of substring.      ║
  106.      ║                                                                  ║
  107.      ║                                                                  ║
  108.      ║       Result:                                                    ║
  109.      ║                                                                  ║
  110.      ║           A substring of l positions beginning at b is returned. ║
  111.      ║                                                                  ║
  112.      ╚══════════════════════════════════════════════════════════════════╝
  113. }
  114.  
  115.  
  116. Function SubStr(s : string; b,l : integer) : string;
  117. var
  118.    st : string;
  119.    i  : integer;
  120. begin
  121.    st := '';
  122.    if b < 0 then b := 1;
  123.    st := copy(s, b, l);
  124.    SubStr := st;
  125. end;
  126. {.pa}
  127. {
  128.  
  129.                                     TRIML
  130.  
  131.      ╔══════════════════════════════════════════════════════════════════╗
  132.      ║                                                                  ║
  133.      ║   The TRIML function removes leading spaces from a field.        ║
  134.      ║                                                                  ║
  135.      ║       Calling the Method:                                        ║
  136.      ║                                                                  ║
  137.      ║                d := TrimL(x)                                     ║
  138.      ║                                                                  ║
  139.      ║               ( where x is the string to be trimmed.             ║
  140.      ║                       d is of type string.                       ║
  141.      ║                                                                  ║
  142.      ║       Result:                                                    ║
  143.      ║                                                                  ║
  144.      ║           Leading spaces are removed and the field returned.     ║
  145.      ║                                                                  ║
  146.      ╚══════════════════════════════════════════════════════════════════╝
  147. }
  148.  
  149.  
  150. function TrimL(strn : string) : string;
  151. var
  152.    st : string;
  153. begin
  154.    st := strn;                        {Load work string}
  155.    while (length(st) > 0) and (st[1] = ' ') do delete(st, 1, 1);
  156.                                       {Loop to delete leading spaces}
  157.    TrimL := st;                       {Return trimmed string}
  158. end;
  159. {.pa}
  160. {
  161.  
  162.                                     TRIMR
  163.  
  164.      ╔══════════════════════════════════════════════════════════════════╗
  165.      ║                                                                  ║
  166.      ║   The TRIMR function removes trailing spaces from a field.       ║
  167.      ║                                                                  ║
  168.      ║       Calling the Method:                                        ║
  169.      ║                                                                  ║
  170.      ║                d := TrimR(x)                                     ║
  171.      ║                                                                  ║
  172.      ║               ( where x is the string to be trimmed.             ║
  173.      ║                       d is of type string.                       ║
  174.      ║                                                                  ║
  175.      ║       Result:                                                    ║
  176.      ║                                                                  ║
  177.      ║           Trailing spaces are removed and the field returned.    ║
  178.      ║                                                                  ║
  179.      ╚══════════════════════════════════════════════════════════════════╝
  180. }
  181.  
  182.  
  183. function TrimR(strn : string) : string;
  184. var
  185.    l  : integer;
  186.    st : string;
  187. begin
  188.    st := strn;                        {Load work string}
  189.    l := length(st);                   {Load string length}
  190.    st[0] := '*';                      {Ensure string length is not decimal 32,}
  191.                                       {which is an ASCII space}
  192.    while st[l] = ' ' do dec(l);       {Loop searching down to first non-blank}
  193.    st[0] := chr(l);                   {Set string to new length}
  194.    TrimR := st;                       {Return trimmed length}
  195. end;
  196. {.pa}
  197. {
  198.  
  199.                                  UNIQUE_FIELD
  200.  
  201.      ╔══════════════════════════════════════════════════════════════════╗
  202.      ║                                                                  ║
  203.      ║   The UNIQUE-FIELD function creates an eight-character unique    ║
  204.      ║   value which may be used as a unique field for a database       ║
  205.      ║   record.  The value is based on the data and time of the        ║
  206.      ║   function call, and is down to hundredths of a second.  Thus,   ║
  207.      ║   each value returned will be unique.                            ║
  208.      ║                                                                  ║
  209.      ║       Calling the Method:                                        ║
  210.      ║                                                                  ║
  211.      ║                d := Unique_Field                                 ║
  212.      ║                                                                  ║
  213.      ║               ( where d is a string of length 8.                 ║
  214.      ║                                                                  ║
  215.      ║       Result:                                                    ║
  216.      ║                                                                  ║
  217.      ║           An 8-byte unique string of characters is returned.     ║
  218.      ║                                                                  ║
  219.      ╚══════════════════════════════════════════════════════════════════╝
  220. }
  221.  
  222.  
  223. function Unique_Field : string;
  224. var
  225.    y, mo, d, dow : Word;
  226.    h, mn, s, hund : Word;
  227.    LS,
  228.    LM : string;
  229.  
  230. {
  231.                     ┌─────────────────────────────────────┐
  232.                     │  Convert a number to a character.   │
  233.                     │  Uses the ASCII characters starting │
  234.                     │  at ASCII 64                        │
  235.                     └─────────────────────────────────────┘
  236. }
  237.  
  238.    function LZ(w : Word) : String;
  239.    begin
  240.       LZ := chr(w+64);
  241.    end;
  242.  
  243. {
  244.                    ┌──────────────────────────────────────┐
  245.                    │  Beginning of Unique_Field function  │
  246.                    └──────────────────────────────────────┘
  247. }
  248. begin
  249.    GetDate(y,mo,d,dow);               {Call TP 5.5 procedure for current date}
  250.    LS := LZ(y mod 10)+LZ(mo)+LZ(d);   {Convert last digit of year, month, and}
  251.                                       {day to three individual ASCII characters}
  252.                                       {and concatenate}
  253.  
  254.    GetTime(h,mn,s,hund);              {Call TP 5.5 procedure for current time}
  255.    LS := LS+LZ(h)+LZ(mn)+LZ(s)+LZ(hund div 10)+LZ(hund mod 10);
  256.                                       {Convert hour, minute, second, and the}
  257.                                       {tens and units digits of the hundredths}
  258.                                       {of seconds to individual ASCII digits}
  259.                                       {and concatenate with the date string}
  260.  
  261.    delay(100);                        {Delay to ensure next call will retrieve}
  262.                                       {an unique time stamp}
  263.    Unique_Field := LS;                {Return the unique field}
  264.  end;
  265.  
  266. function ValNumber(strn : string) : real;
  267. var
  268.    r : integer;
  269.    n : real;
  270. begin
  271.    val(strn,n,r);
  272.    if r <> 0 then ValNumber := 0
  273.       else ValNumber := n;
  274. end;
  275.  
  276. function ValLogic(strn : string) : boolean;
  277. var
  278.    c : char;
  279. begin
  280.    if strn[0] <> #1 then ValLogic := false
  281.    else
  282.    begin
  283.       c := strn[1];
  284.       if c in ['T','t','Y','y'] then ValLogic := true
  285.          else ValLogic := false;
  286.    end;
  287. end;
  288.  
  289.  
  290. end.